home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / VarHelper 17995462001.psc / IEnumVariant.bas < prev    next >
Encoding:
BASIC Source File  |  2001-02-24  |  7.8 KB  |  269 lines
  1. Attribute VB_Name = "mdlIEnumVariant"
  2. '*********************************************************************************************
  3. '
  4. ' FastCollection Class
  5. '
  6. ' IEnumVARIANT light-weight object
  7. '
  8. '*********************************************************************************************
  9. '
  10. ' Author: Eduardo Morcillo
  11. ' E-Mail: edanmo@geocities.com
  12. ' Web Page: http://www.domaindlx.com/e_morcillo
  13. '
  14. ' Distribution: You can freely use this code in your own applications but you
  15. '               can't publish this code in a web site, online service, or any
  16. '               other media,  without my express permission.
  17. '
  18. ' Usage: at your own risk.
  19. '
  20. ' Tested on: Windows 98
  21. '
  22. ' History:
  23. '          05/27/2000 * The object uses the
  24. '                       SAFEARRAY from the
  25. '                       FastCollection class.
  26. '          04/26/2000 * Fixed a bug on the Next_
  27. '                       method that which didn't
  28. '                       return the item.
  29. '          04/25/2000 * Code was released
  30. '
  31. '*********************************************************************************************
  32. Option Explicit
  33.  
  34. Private Type IEnumVARIANT  ' Object struct
  35.   vtable As Long       ' Pointer to vtable
  36.   RefCount As Long     ' Reference count
  37.   hHeap As Long        ' Handle of heap object used to create the object
  38.   Items() As Long      ' Array of items
  39.   MaxIdx As Long       ' Number of items
  40.   CurrentIndex As Long ' Current index
  41. End Type
  42.  
  43. Private Type UUID
  44.   Data1 As Long
  45.   Data2 As Integer
  46.   Data3 As Integer
  47.   Data4(0 To 7) As Byte
  48. End Type
  49.  
  50. Const sIID_IUnknown = "{00000000-0000-0000-C000-000000000046}"
  51. Const sIID_IEnumVARIANT = "{00020404-0000-0000-C000-000000000046}"
  52.  
  53. Dim IID_IUnknown As UUID
  54. Dim IID_IEnumVARIANT As UUID
  55.  
  56. ' ==== API Declarations ====
  57.  
  58. Type SAFEARRAYBOUND
  59.  
  60.   cElements As Long      ' Element count
  61.   lLbound As Long        ' LBound
  62. End Type
  63.  
  64. Type SAFEARRAY_1D
  65.  
  66.   cDims As Integer       ' Number of dimensions
  67.   fFeatures As Integer   ' Flags
  68.   cbElements As Long     ' Length of each element
  69.   cLocks As Long         ' Lock count
  70.   pvData As Long         ' Pointer to the data
  71.   Bounds(0 To 0) As SAFEARRAYBOUND   ' Array of dimensions
  72. End Type
  73.  
  74. Public Const HEAP_ZERO_MEMORY = &H8&
  75.  
  76. Declare Function HeapCreate Lib "kernel32" (ByVal flOptions As Long, ByVal dwInitialSize As Long, ByVal dwMaximumSize As Long) As Long
  77. Declare Function HeapDestroy Lib "kernel32" (ByVal hHeap As Long) As Long
  78. Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
  79. Declare Function HeapReAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal lpMem As Long, ByVal dwBytes As Long) As Long
  80. Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal lpMem As Long) As Long
  81. Declare Function HeapSize Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal lpMem As Long) As Long
  82.  
  83. Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb As Long)
  84.  
  85. Declare Function VariantCopyIndPtrVar Lib "oleaut32" Alias "VariantCopyInd" (ByVal pvargDest As Long, pvargSrc As Variant) As Long
  86. Declare Function VariantCopyVarPtr Lib "oleaut32" Alias "VariantCopy" (pvargDest As Variant, ByVal pvargSrc As Long) As Long
  87. Declare Function VariantClear Lib "oleaut32" (ByVal pvarg As Long) As Long
  88.  
  89. Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, rguid As UUID) As Long
  90. Private Declare Function IsEqualGUID Lib "ole32" (rguid1 As UUID, rguid2 As UUID) As Boolean
  91.  
  92. Declare Function VarPtrArray Lib "kernel32" Alias "lstrcpyA" (PtrDest() As Any, PtrSrc() As Any) As Long
  93.  
  94. Const S_FALSE = &H1&
  95. Const E_NOTIMPL = &H80004001
  96. Const E_NOINTERFACE = &H80004002
  97.  
  98. Private Function AddRef(This As IEnumVARIANT) As Long
  99.  
  100.  ' Increment the reference count
  101.  
  102.   This.RefCount = This.RefCount + 1
  103.  
  104.   ' Return the reference count
  105.   AddRef = This.RefCount
  106.  
  107. End Function
  108.  
  109. Private Function AddrOf(ByVal Add As Long) As Long
  110.  
  111.   AddrOf = Add
  112.  
  113. End Function
  114.  
  115. Private Function Clone(This As IEnumVARIANT, NewIEnumVARIANT As IEnumVARIANT) As Long
  116.  
  117.   Clone = E_NOTIMPL
  118.  
  119. End Function
  120.  
  121. Public Function CreateIEnumVARIANT(ByVal hHeap As Long, _
  122.                                    ItemSA As SAFEARRAY_1D) As IUnknown
  123.  
  124.  Dim vtable(0 To 6) As Long
  125.  Dim IEnm As IEnumVARIANT, lObjPtr As Long
  126.  
  127.   ' Initialize IIDs
  128.   IIDFromString StrPtr(sIID_IEnumVARIANT), IID_IEnumVARIANT
  129.   IIDFromString StrPtr(sIID_IUnknown), IID_IUnknown
  130.  
  131.   ' Create the v-table
  132.   vtable(0) = AddrOf(AddressOf QueryInterface) ' IUnknown.QueryInterface
  133.   vtable(1) = AddrOf(AddressOf AddRef)         ' IUnknown.AddRef
  134.   vtable(2) = AddrOf(AddressOf Release)        ' IUnknown.Release
  135.   vtable(3) = AddrOf(AddressOf Next_)          ' IEnumVARIANT.Next
  136.   vtable(4) = AddrOf(AddressOf Skip)           ' IEnumVARIANT.Skip
  137.   vtable(5) = AddrOf(AddressOf Reset)          ' IEnumVARIANT.Reset
  138.   vtable(6) = AddrOf(AddressOf Clone)          ' IEnumVARIANT.Clone
  139.  
  140.   ' Fill a temporary IEnumVariant struct
  141.   With IEnm
  142.  
  143.     ' Copy the pointer to
  144.     ' the SAFEARRAY to the array
  145.     MoveMemory ByVal VarPtrArray(.Items, .Items), VarPtr(ItemSA), 4
  146.  
  147.     .CurrentIndex = 1
  148.     .MaxIdx = ItemSA.Bounds(0).cElements
  149.     .hHeap = hHeap
  150.     .RefCount = 1
  151.  
  152.     ' Allocate memory for the vtable
  153.     .vtable = HeapAlloc(hHeap, HEAP_ZERO_MEMORY, 28)
  154.  
  155.     ' Copy the v-table
  156.     MoveMemory ByVal .vtable, vtable(0), 28
  157.  
  158.   End With
  159.  
  160.   ' Allocate memory for the object
  161.   lObjPtr = HeapAlloc(hHeap, HEAP_ZERO_MEMORY, LenB(IEnm))
  162.  
  163.   ' Copy the struct to the allocated memory
  164.   MoveMemory ByVal lObjPtr, IEnm, LenB(IEnm)
  165.  
  166.   ' Remove the SAFEARRAY struct
  167.   ' from the temporary IEnumVARIANT UDT
  168.   MoveMemory ByVal VarPtrArray(IEnm.Items, IEnm.Items), 0&, 4
  169.  
  170.   ' Copt the pointer to the return value
  171.   MoveMemory CreateIEnumVARIANT, lObjPtr, 4
  172.  
  173. End Function
  174.  
  175. ':) Ulli's Code Formatter V2.0 (2001-01-23 10:53:24) 95 + 170 = 265 Lines
  176.  
  177.  
  178. Private Function QueryInterface(This As IEnumVARIANT, riid As UUID, lObj As Long) As Long
  179.  
  180.   If IsEqualGUID(riid, IID_IUnknown) Or _
  181.      IsEqualGUID(riid, IID_IEnumVARIANT) Then
  182.  
  183.     ' Return a pointer to
  184.     ' this object
  185.     lObj = VarPtr(This)
  186.  
  187.     ' Increment the reference count
  188.     This.RefCount = This.RefCount + 1
  189.  
  190.    Else
  191.  
  192.     ' Set the return value to "Nothing"
  193.     lObj = 0
  194.  
  195.     ' Return the error
  196.     QueryInterface = E_NOINTERFACE
  197.  
  198.   End If
  199.  
  200. End Function
  201.  
  202.  
  203. Private Function Release(This As IEnumVARIANT) As Long
  204.  
  205.  ' Decrement the reference count
  206.  
  207.   This.RefCount = This.RefCount - 1
  208.  
  209.   ' Return the reference count
  210.   Release = This.RefCount
  211.  
  212.   ' Destroy the object if
  213.   ' the reference count is 0
  214.   If This.RefCount = 0 Then
  215.  
  216.     ' Remove the reference from
  217.     ' the items array
  218.     MoveMemory ByVal VarPtrArray(This.Items, This.Items), 0&, 4
  219.  
  220.     ' Release the memory
  221.     ' used by the v-table
  222.     HeapFree This.hHeap, 0, This.vtable
  223.  
  224.     ' Release the object itself
  225.     HeapFree This.hHeap, 0, VarPtr(This)
  226.  
  227.   End If
  228.  
  229. End Function
  230.  
  231. Private Function Reset(This As IEnumVARIANT) As Long
  232.  
  233.   This.CurrentIndex = 1
  234.  
  235. End Function
  236.  
  237. Private Function Skip(This As IEnumVARIANT, ByVal celt As Long) As Long
  238.  
  239.   This.CurrentIndex = This.CurrentIndex + celt
  240.  
  241. End Function
  242.  
  243. Private Function Next_(This As IEnumVARIANT, ByVal celt As Long, rgVar As Variant, ByVal lpCeltFetched As Long) As Long
  244.  
  245.   With This
  246.  
  247.     If .CurrentIndex <= .MaxIdx Then
  248.  
  249.       ' Return a copy of the
  250.       ' stored variant
  251.       VariantCopyVarPtr rgVar, .Items(.CurrentIndex)
  252.  
  253.       ' Increment the index
  254.       .CurrentIndex = .CurrentIndex + 1
  255.  
  256.       If lpCeltFetched Then MoveMemory ByVal lpCeltFetched, 1, 4
  257.  
  258.      Else
  259.  
  260.       If lpCeltFetched Then MoveMemory ByVal lpCeltFetched, 0, 4
  261.  
  262.       Next_ = S_FALSE
  263.  
  264.     End If
  265.  
  266.   End With
  267.  
  268. End Function
  269.